home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / packages / upd-copyr.el.z / upd-copyr.el
Encoding:
Text File  |  1998-05-21  |  9.9 KB  |  275 lines
  1. ;;; upd-copyr.el --- update the copyright notice in a GNU Emacs Lisp file
  2.  
  3. ;;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
  4. ;;; Copyright (C) 1994, 1995 Tinker Systems and INS Engineering Corp.
  5.  
  6. ;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
  7. ;; hacked on by Jamie Zawinski.
  8. ;; hacked upon by Jonathan Stigelman <Stig@hackvan.com>
  9. ;; Keywords: maint
  10.  
  11. ;; This file is part of XEmacs.
  12.  
  13. ;; XEmacs is free software; you can redistribute it and/or modify it
  14. ;; under the terms of the GNU General Public License as published by
  15. ;; the Free Software Foundation; either version 2, or (at your option)
  16. ;; any later version.
  17.  
  18. ;; XEmacs is distributed in the hope that it will be useful, but
  19. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  20. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21. ;; General Public License for more details.
  22.  
  23. ;; You should have received a copy of the GNU General Public License
  24. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  25. ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26. ;; Boston, MA 02111-1307, USA.
  27. ;;; 02139, USA.
  28.  
  29. ;;; Synched up with: Not synched with FSF.
  30. ;;; Apparently mly synched this file with the version of upd-copyr.el
  31. ;;; supplied with FSF 19.22 or 19.23.  Since then, FSF renamed the
  32. ;;; file to copyright.el and basically rewrote it, and Stig and Jamie
  33. ;;; basically rewrote it, so there's not much in common any more.
  34.  
  35. ;;; Code:
  36.  
  37. (defgroup copyright nil
  38.   "Update the copyright notice in a Lisp file."
  39.   :group 'maint)
  40.  
  41.  
  42. ;; #### - this will break if you dump it into emacs
  43. (defconst copyright-year (substring (current-time-string) -4)
  44.   "String representing the current year.")
  45.  
  46. ;;;###autoload
  47. (defcustom copyright-do-not-disturb "Free Software Foundation, Inc."
  48.   "*If non-nil, the existing copyright holder is checked against this regexp.
  49. If it does not match, then a new copyright line is added with the copyright
  50. holder set to the value of `copyright-whoami'."
  51.   :type '(choice (const nil) string)
  52.   :group 'copyright) 
  53.  
  54. ;;;###autoload
  55. (defcustom copyright-whoami nil
  56.   "*A string containing the name of the owner of new copyright notices."
  57.   :type '(choice (const nil) string)
  58.   :group 'copyright)
  59.  
  60. ;;;###autoload
  61. (defcustom copyright-notice-file nil
  62.   "*If non-nil, replace copying notices with this file."
  63.   :type '(choice (const nil) file)
  64.   :group 'copyright)
  65.  
  66. (defcustom copyright-files-to-ignore-regex "loaddefs.el$"
  67.   "*Regular expression for files that should be ignored"
  68.   :type 'regexp)
  69.  
  70. (defvar current-gpl-version "2"
  71.   "String representing the current version of the GPL.")
  72.  
  73. (defvar copyright-inhibit-update nil
  74.   "If nil, ask the user whether or not to update the copyright notice.
  75. If the user has said no, we set this to t locally.")
  76.  
  77. (defvar copyright-search-limit 2048
  78.   "Portion of file to search for copyright notices")
  79.  
  80. ;;;###autoload
  81. (defun update-copyright (&optional replace ask-upd ask-year)
  82.   "Update the copyright notice at the beginning of the buffer
  83. to indicate the current year.  If optional arg REPLACE is given
  84. \(interactively, with prefix arg\) replace the years in the notice
  85. rather than adding the current year after them.
  86. If `copyright-notice-file' is set, the copying permissions following the
  87. copyright are replaced as well.
  88.  
  89. If optional third argument ASK is non-nil, the user is prompted for whether
  90. or not to update the copyright.  If optional fourth argument ASK-YEAR is
  91. non-nil, the user is prompted for whether or not to replace the year rather
  92. than adding to it."
  93.   (interactive "*P")
  94.   (or (and ask-upd copyright-inhibit-update)
  95.       (and buffer-file-truename
  96.        (string-match copyright-files-to-ignore-regex buffer-file-truename))
  97.       (save-excursion
  98.     (save-restriction
  99.       (widen)
  100.       (goto-char (point-min))
  101.       (narrow-to-region (point-min)
  102.                 (min copyright-search-limit (point-max)))
  103.       ;; Handle abbreviated year lists like "1800, 01, 02, 03"
  104.       ;; or "1900, '01, '02, '03".
  105.       (let ((case-fold-search t)
  106.         p-string holder add-new
  107.         mine current
  108.         cw-current cw-mine last-cw
  109.         (cw-position '(lambda ()
  110.                 (goto-char (point-min))
  111.                 (cond (cw-mine (goto-char cw-mine))
  112.                       ((or (and last-cw (goto-char last-cw))
  113.                        (re-search-forward
  114.                         "copyright[^0-9\n]*\\([-, \t]*\\([0-9]+\\)\\)+"
  115.                         nil t))
  116.                        (and add-new (beginning-of-line 2)))
  117.                       (t (goto-char (point-min)))))))
  118.         ;; scan for all copyrights
  119.         (while (re-search-forward
  120.             (concat "^\\(.*\\)copyright.*\\(" (substring copyright-year 0 2)
  121.                 "\\)?" "\\([0-9][0-9]\\(, \t\\)+\\)*'?"
  122.                 "\\(\\(" (substring copyright-year 2) "\\)\\|[0-9][0-9]\\)\\s *\\(\\S .*\\)$")
  123.             nil t)
  124.           (buffer-substring (match-beginning 0) (match-end 0))
  125.           (setq p-string (buffer-substring (match-beginning 1)
  126.                            (match-end 1))
  127.             last-cw   (match-end 5)
  128.             holder    (buffer-substring (match-beginning 7)
  129.                         (match-end 7))
  130.             current    (match-beginning 6)
  131.             mine       (string-match copyright-do-not-disturb holder)
  132.             cw-current (if mine
  133.                    current
  134.                  (or cw-current current))
  135.             cw-mine (or cw-mine (and mine last-cw))
  136.             ))
  137.         ;; ok, now decide if a new copyright is needed...
  138.         (setq add-new (not cw-mine))
  139.         (or ask-upd add-new
  140.         (message "Copyright notice already includes %s." copyright-year))
  141.         (goto-char (point-min))
  142.         (cond ((and cw-current cw-mine)
  143.            (or ask-upd (message "The copyright is up to date"))
  144.            (copyright-check-notice))
  145.           ((and (or add-new (not cw-current))
  146.             ;; #### - doesn't bother to ask about non-GPL sources
  147.             (or (not ask-upd)
  148.                 (prog1
  149.                 (search-forward "is free software" nil t)
  150.                   (goto-char (point-min))))
  151.             ;; adding a new copyright or one exists already...
  152.             (or add-new last-cw)
  153.             ;; adding a new copyright or the user wants to update...
  154.             (or (not ask-upd)
  155.                 (save-window-excursion
  156.                   (pop-to-buffer (current-buffer))
  157.                   ;; Show user the copyright.
  158.                   (funcall cw-position)
  159.                   (sit-for 0)
  160.                   (or (y-or-n-p "Update copyright? ")
  161.                   (progn
  162.                     (set (make-local-variable
  163.                       'copyright-inhibit-update) t)
  164.                     nil)))))
  165.            ;; The "XEmacs change" below effectively disabled this
  166.            ;; already, so I'm gonna comment it out entirely...  --Stig
  167.            ;; (setq replace
  168.            ;;       (or replace
  169.            ;;           (and ask-year
  170.            ;;                (save-window-excursion
  171.            ;;                  (pop-to-buffer (current-buffer))
  172.            ;;                  (save-excursion
  173.            ;;                    ;; Show the user the copyright.
  174.            ;;                    (goto-char (point-min))
  175.            ;;                    ;;XEmacs change
  176.            ;;                    ;; (sit-for 0)
  177.            ;;                    ;; (y-or-n-p "Replace copyright year? ")
  178.            ;;                    nil
  179.            ;;                    )))))
  180.            (cond (add-new
  181.               ;; the cursor should already be at the beginning of a
  182.               ;; line here...
  183.               (funcall cw-position)
  184.               (setq holder (or copyright-whoami
  185.                        (read-string "New copyright holder: ")))
  186.               (if p-string (insert p-string) (indent-for-comment))
  187.               (insert "Copyright (C) ")
  188.               (save-excursion
  189.                 (insert " " holder "\n"))
  190.               )
  191.              (replace
  192.               ;; #### - check this...
  193.               (beginning-of-line)
  194.               (re-search-forward "copyright\\([^0-9]*\\([-, \t]*\\([0-9]+\\)\\)+\\)"
  195.                          (save-excursion (end-of-line)
  196.                                  (point)))
  197.               (delete-region (match-beginning 1) (match-end 1)))
  198.              (t (insert ", ")
  199.                 ;; This did the wrong thing:  "1990-1992" -> "1990, 1992"
  200.                 ;; Perhaps "1990, 1991, 1992" would be an appropriate 
  201.                 ;; substitution, but "1990-1992" is satisfactory.  --Stig
  202.                 ;;
  203.                 ;; XEmacs addition
  204.                 ;; (save-excursion
  205.                 ;;   (goto-char (match-beginning 1))
  206.                 ;;   (if (looking-at "[0-9][0-9][0-9][0-9]-[0-9][0-9][0-9][0-9]")
  207.                 ;;       (progn (forward-char 4)
  208.                 ;;          (delete-char 1)
  209.                 ;;          (insert ", "))))
  210.                 ))
  211.            (insert copyright-year)
  212.            ;; XEmacs addition
  213.            ;; #### - this assumes lisp and shouldn't
  214.            (if (save-excursion
  215.              (end-of-line)
  216.              (>= (current-column) fill-column))
  217.                (if (= (char-syntax ?\;) ?<)
  218.                (insert "\n;;;")
  219.              (insert "\n  ")))
  220.            (message "Copyright updated to %s%s."
  221.                 (if replace "" "include ") copyright-year)
  222.            (copyright-check-notice)
  223.            ;; show the newly-munged copyright.
  224.            (message "The copyright has been updated")
  225.            (sit-for 1))
  226.           ((not ask-upd)
  227.            (error "This buffer does not contain a copyright notice!"))
  228.           ))))))
  229.  
  230. (defun copyright-check-notice ()
  231.   (if copyright-notice-file
  232.       (let (beg)
  233.     (goto-char (point-min))
  234.     ;; Find the beginning of the copyright.
  235.     (if (search-forward "copyright" nil t)
  236.         (progn
  237.           ;; Look for a blank line or a line with only comment chars.
  238.           (if (re-search-forward "^\\(\\s \\s<\\|\\s>\\)*$" nil t)
  239.           (forward-line 1)
  240.         (with-output-to-temp-buffer "*Help*"
  241.           (princ (substitute-command-keys "\
  242. I don't know where the copying notice begins.
  243. Put point there and hit \\[exit-recursive-edit]."))
  244.           (recursive-edit)))
  245.           (setq beg (point))
  246.           (or (search-forward "02139, USA." nil t)
  247.           (with-output-to-temp-buffer "*Help*"
  248.             (princ (substitute-command-keys "\
  249. I don't know where the copying notice ends.
  250. Put point there and hit \\[exit-recursive-edit]."))
  251.             (recursive-edit)))
  252.           (delete-region beg (point))))
  253.     (insert-file copyright-notice-file))
  254.     (if (re-search-forward
  255.      "; either version \\(.+\\), or (at your option)"
  256.      nil t)
  257.     (progn
  258.       (goto-char (match-beginning 1))
  259.       (delete-region (point) (match-end 1))
  260.       (insert current-gpl-version)))))
  261.  
  262. ;;;###autoload
  263. (defun ask-to-update-copyright ()
  264.   "If the current buffer contains a copyright notice that is out of date,
  265. ask the user if it should be updated with `update-copyright' (which see).
  266. Put this on write-file-hooks."
  267.   (update-copyright nil t t)
  268.   ;; Be sure return nil; if a write-file-hook return non-nil,
  269.   ;; the file is presumed to be already written.
  270.   nil)
  271.  
  272. (provide 'upd-copyr)
  273.  
  274. ;;; upd-copyr.el ends here
  275.